在VBA中对一个多维数组进行排序

您所在的位置：网站首页 › jq 数组排序 › 在VBA中对一个多维数组进行排序

在VBA中对一个多维数组进行排序

2023-04-15 17:02| 来源: 网络整理| 查看: 265

百度翻译此文有道翻译此文问题描述

I have defined the following Array Dim myArray(10,5) as Long and would like to sort it. What would be the best method to do that?

I will need to handle a lot of data like a 1000 x 5 Matrix. It contains mainly numbers and dates and need to sort it according to a certain column

推荐答案

Here's a multi-column and a single-column QuickSort for VBA, modified from a code sample posted by Jim Rech on Usenet.

Notes:

You'll notice that I do a lot more defensive coding than you'll see in most of the code samples out there on the web: this is an Excel forum, and you've got to anticipate nulls and empty values... Or nested arrays and objects in arrays if your source array comes from (say) a third-party realtime market data source.

Empty values and invalid items are sent to the end of the list.

To sort multi-column arrays, your call will be:

QuickSortArray MyArray,,,2 ...Passing '2' as the column to sort on and excluding the optional parameters that pass the upper and lower bounds of the search domain.

Sorting single-column arrays (vectors), instead use:

QuickSortVector Myarray Here too excluding the optional parameters.

[EDITED] - fixed an odd formatting glitch in the tags, which seem to have a problem with hyperlinks in code comments.

The Hyperlink I excised was Detecting an Array Variant in VBA.

Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0) On Error Resume Next 'Sort a 2-Dimensional array ' SampleUsage: sort arrData by the contents of column 3 ' ' QuickSortArray arrData, , , 3 ' 'Posted by Jim Rech 10/20/98 Excel.Programming 'Modifications, Nigel Heffernan: ' ' Escape failed comparison with empty variant ' ' Defensive coding: check inputs Dim i As Long Dim j As Long Dim varMid As Variant Dim arrRowTemp As Variant Dim lngColTemp As Long If IsEmpty(SortArray) Then Exit Sub End If If InStr(TypeName(SortArray), "()") < 1 Then 'IsArray() is somewhat broken: Look for brackets in the type name Exit Sub End If If lngMin = -1 Then lngMin = LBound(SortArray, 1) End If If lngMax = -1 Then lngMax = UBound(SortArray, 1) End If If lngMin >= lngMax Then ' no sorting required Exit Sub End If i = lngMin j = lngMax varMid = Empty varMid = SortArray((lngMin + lngMax) \ 2, lngColumn) ' We send 'Empty' and invalid data items to the end of the list: If IsObject(varMid) Then ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property i = lngMax j = lngMin ElseIf IsEmpty(varMid) Then i = lngMax j = lngMin ElseIf IsNull(varMid) Then i = lngMax j = lngMin ElseIf varMid = "" Then i = lngMax j = lngMin ElseIf VarType(varMid) = vbError Then i = lngMax j = lngMin ElseIf VarType(varMid) > 17 Then i = lngMax j = lngMin End If While i lngMin j = j - 1 Wend If i InputArray(j) Then varTemp = InputArray(j) InputArray(j) = InputArray(i) InputArray(i) = varTemp End If Next j Next i Case 2 iFirstRow = LBound(InputArray, 1) iLastRow = UBound(InputArray, 1) iFirstCol = LBound(InputArray, 2) iLastCol = UBound(InputArray, 2) If SortColumn InputArray(j, SortColumn) Then For k = iFirstCol To iLastCol varTemp = InputArray(j, k) InputArray(j, k) = InputArray(i, k) InputArray(i, k) = varTemp Next k End If Next j Next i End Select If Descending Then OutputArray = InputArray For i = LBound(InputArray, 1) To UBound(InputArray, 1) k = 1 + UBound(InputArray, 1) - i For j = LBound(InputArray, 2) To UBound(InputArray, 2) InputArray(i, j) = OutputArray(k, j) Next j Next i Erase OutputArray End If End Sub

This answer may have arrived a bit late to solve your problem when you needed to, but other people will pick it up when they Google for answers for similar problems.

其他推荐答案

The hard part is that VBA provides no straightforward way to swap rows in a 2D array. For each swap, you're going to have to loop over 5 elements and swap each one, which will be very inefficient.

I'm guessing that a 2D array is really not what you should be using anyway though. Does each column have a specific meaning? If so, should you not be using an array of a user-defined type, or an array of objects that are instances of a class module? Even if the 5 columns don't have specific meanings, you could still do this, but define the UDT or class module to have just a single member that is a 5-element array.

For the sort algorithm itself, I would use a plain ol' Insertion Sort. 1000 items is actually not that big, and you probably won't notice the difference between an Insertion Sort and Quick Sort, so long as we've made sure that each swap will not be too slow. If you do use a Quick Sort, you'll need to code it carefully to make sure you won't run out of stack space, which can be done, but it's complicated, and Quick Sort is tricky enough already.

So assuming you use an array of UDTs, and assuming the UDT contains variants named Field1 through Field5, and assuming we want to sort on Field2 (for example), then the code might look something like this...

Type MyType Field1 As Variant Field2 As Variant Field3 As Variant Field4 As Variant Field5 As Variant End Type Sub SortMyDataByField2(ByRef Data() As MyType) Dim FirstIdx as Long, LastIdx as Long FirstIdx = LBound(Data) LastIdx = UBound(Data) Dim I as Long, J as Long, Temp As MyType For I=FirstIdx to LastIdx-1 For J=I+1 to LastIdx If Data(I).Field2 > Data(J).Field2 Then Temp = Data(I) Data(I) = Data(J) Data(J) = Temp End If Next J Next I End Sub 其他推荐答案

sometimes the most brainless answer is the best answer.

add blank sheet download your array to that sheet add the sort fields apply the sort reupload the sheet data back to your array it will be the same dimension delete the sheet

tadaa. wont win you any programming prizes but it gets the job done fast.

【本文地址】

在VBA中对一个多维数组进行排序

在VBA中对一个多维数组进行排序

今日新闻

推荐新闻